home *** CD-ROM | disk | FTP | other *** search
/ Macwelt 1 / Macwelt DVD 1.toast / Web-Publishing / HTML-Editoren / Alpha ƒ / Tcl / SystemCode / CorePackages / quotingStrings.tcl < prev    next >
Encoding:
Text File  |  2001-01-17  |  5.3 KB  |  182 lines
  1. #  AlphaTcl - core Tcl engine
  2.  
  3. namespace eval quote {}
  4.  
  5. ## 
  6.  # -------------------------------------------------------------------------
  7.  # 
  8.  # "quote::" --
  9.  # 
  10.  # Manipulate string so search and insertion procedures work as expected.
  11.  # When strings are passed to functions such as 'regexp', 'glob', 
  12.  # 'lsearch -glob', etc. certain characters in those strings will be
  13.  # interpreted as special (in some sense) unless they are preceded
  14.  # by a backslash '\' character.  Exactly which characters have this
  15.  # effect depends on the command in question.  These procedures allow
  16.  # you to quote exactly the right characters so the commands work
  17.  # as expected with arbitrary strings.
  18.  # 
  19.  # Of course, these procedures should only be used when you want to
  20.  # avoid the effect of the special characters -- usually you don't!
  21.  # 
  22.  # quote::Find
  23.  # 
  24.  #  Use this for 'glob' type searches, but not 'glob' itself!  The
  25.  #  commands 'string match', 'lsearch -glob' need their arguments
  26.  #  quoted with this procedure.
  27.  #  
  28.  # quote::Glob
  29.  #  
  30.  #  Glob treats expressions like {a,b,c} specially, in addition to
  31.  #  *,? etc, so requires a separate procedure.
  32.  #     
  33.  # quote::Regfind
  34.  # 
  35.  #  Use this for regexp searches.  Note that this procedure hasn't
  36.  #  been tested much with the advanced regexps in Tcl 8.2
  37.  #  
  38.  # quote::Regsub
  39.  # 
  40.  #  Use this for the replacement expression.  A common usage might look
  41.  #  like this:
  42.  #   
  43.  #   regsub -all [quote::Regfind $from] [read $cid] [quote::Regsub $to] out
  44.  #  
  45.  # quote::Insert
  46.  # 
  47.  #  Quotes any block of text captured from a window so it can be used as a 
  48.  #  Tcl string. e.g. 'set a [quote::Insert [getSelect]] ; eval insertText $a'
  49.  #  will work correctly.  Can be used to generate procedures on the fly,
  50.  #  especially to add to your prefs.tcl:
  51.  #  
  52.  #   set a [quote::Insert [getSelect]]
  53.  #   prefs::tclAddLine "proc foo \{\} \{ return \"$a\" \}"
  54.  # 
  55.  # -------------------------------------------------------------------------
  56.  ##
  57. proc quote::Find  str {
  58.     regsub -all {[][\\*?]} $str {\\&} str
  59.     return $str
  60. }
  61.  
  62. proc quote::Regfind str {
  63.     regsub -all {[][\$?^|*+()\.\{\}\\]} $str {\\&} str
  64.     return $str
  65. }
  66.  
  67. proc quote::Regsub str {
  68.     regsub -all {(\\|&)} $str {\\&} str
  69.     return $str
  70. }
  71.  
  72. proc quote::Glob str {
  73.     regsub -all {[][*?\{\}\\]} $str {\\&} str
  74.     return $str
  75. }
  76.  
  77. proc quote::Insert str {
  78.     regsub -all {[][\$"\{\}]} $str {\\&} str
  79.     regsub -all "\[\r\n\]" $str "\\r" str
  80.     regsub -all "\t" $str "\\t" str
  81.     return $str
  82. }
  83.  
  84. ## 
  85.  # -------------------------------------------------------------------------
  86.  # 
  87.  # "quote::Url" --
  88.  # 
  89.  #  If you want a piece of arbitrary text to be part of a URL, then
  90.  #  various characters needed to be turned into their hexadecimal
  91.  #  equivalent.  This procedure does that.
  92.  # -------------------------------------------------------------------------
  93.  ##
  94. proc quote::Url {str} {
  95.     set okchars {[a-zA-Z0-9_]} 
  96.     set i 0
  97.     set len [string length $str]
  98.     set res ""
  99.     for {set i 0} {$i < $len} {incr i} {
  100.     set char [string index $str $i]
  101.     if {[regexp $okchars $char]} {
  102.         append res $char
  103.     } else {
  104.         scan $char "%c" ascii
  105.         append res [format "%%%02X" $ascii]
  106.     }
  107.     }
  108.     return $res
  109. }
  110.  
  111. proc quote::Unurl {str} {
  112.     set len [string length $str]
  113.     set res ""
  114.     for {set i 0} {$i < $len} {incr i} {
  115.     set char [string index $str $i]
  116.     if {$char == "%"} {
  117.         incr i
  118.         set chars [string range $str $i [expr {$i+1}]]
  119.         incr i
  120.         append res [format "%c" 0x$chars]
  121.     } else {
  122.         append res $char
  123.     }
  124.     }
  125.     return $res
  126. }
  127.  
  128. # These procs have been modified to avoid substitutions in TeX commands 
  129. # starting with \n, \r and \t. The fix is based on replacing single \ by
  130. # double \\ in 'quote::Display' and replacing \(n|r|t) by their ascii
  131. # counterpart only if there is an odd number of \.
  132. proc quote::Display str {
  133.     regsub -all {\\} $str {\\\\} str
  134.     regsub -all "\r" $str "\\r" str
  135.     regsub -all "\n" $str "\\n" str
  136.     regsub -all "\t" $str "\\t" str
  137.     return $str
  138. }
  139.  
  140. proc quote::Undisplay str {
  141.     regsub -all {(^|[^\\]|(\\\\)+)\\r} $str "\\1\r" str
  142.     regsub -all {(^|[^\\]|(\\\\)+)\\n} $str "\\1\n" str
  143.     regsub -all {(^|[^\\]|(\\\\)+)\\t} $str "\\1\t" str
  144.     regsub -all {\\\\} $str {\\} str
  145.     return $str
  146. }
  147.  
  148. ## 
  149.  # -------------------------------------------------------------------------
  150.  # 
  151.  # "quote::Prettify" --
  152.  # 
  153.  #  Since we're supposed to be a LaTeX editor, we handle symbols with
  154.  #  TeX in a bit differently
  155.  # -------------------------------------------------------------------------
  156.  ##
  157. proc quote::Prettify str {
  158.     set a [string toupper [string index $str 0]]
  159.     regsub -all {([^A-Z])([A-Z])} [string range $str 1 end] {\1 \2} b
  160.     regsub -all {((La|Bib|Oz) )?Te X} $a$b {\2TeX } a
  161.     regsub -all {::} $a {-} a
  162.     return $a
  163. }
  164. proc quote::Menuify str {
  165.     set a [string toupper [string index $str 0]]
  166.     regsub -all { *([A-Z])} [string range $str 1 end] { \1} b
  167.     append a $b
  168. }
  169. ## 
  170.  # -------------------------------------------------------------------------
  171.  # 
  172.  # "quote::WhitespaceReg" --
  173.  # 
  174.  #  Quote a string so you can search for it ignoring all problems with
  175.  #  whitespace: all sequences of space/tab/cr are treated alike.
  176.  # -------------------------------------------------------------------------
  177.  ##
  178. proc quote::WhitespaceReg { str } { 
  179.     regsub -all "\[ \t\r\n\]+" $str {[ \t\r\n]+} str
  180.     return $str
  181. }
  182.